home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 151-175 / scopedisk158 / muchppacker / muchmorepopa.mod < prev    next >
Text File  |  1995-03-19  |  61KB  |  1,871 lines
  1. (*---------------------------------------------------------------------------
  2.  :Program.      MuchMorePoPa.mod
  3.  :Author.       Fridtjof Siebert
  4.  :Address.      Nobileweg 67, D-7000 Stuttgart 40
  5.  :Shortcut.     [fbs]
  6.  :Copyright.    PD
  7.  :Language.     OBERON
  8.  :Translator.   Amiga Oberon Compiler
  9.  :History. V1.0 summer-88: First very slow internal version              [fbs]
  10.  :History. V1.1 24-Sep-88: First published version                       [fbs]
  11.  :History. V1.2 26-Nov-88: Now displays Filelength & Percentage          [fbs]
  12.  :History.      27-Nov-88: Mouse can be used instead of Space / BackSpace[fbs]
  13.  :History. V1.3 29-Apr-89: Strong increase in speed, removed WarpText    [fbs]
  14.  :History.      29-Apr-89: Now supports Numeric Keys (Home,PgUp etc.)    [fbs]
  15.  :History.      29-Apr-89: Now opens Screen as big as gfx.normalDisplay  [fbs]
  16.  :History. V1.4 29/30-Apr-89: Asynchronus loading / displaying. Very nice[fbs]
  17.  :History.      30-Apr-89, 00:33: Removed bugs in Filelength & L-Command [fbs]
  18.  :History.      30-Apr-89, 02:21: Added Find-Command                     [fbs]
  19.  :History.      30-Apr-89, 10:30: Scrolling stops when window is inactive[fbs]
  20.  :History.      01-May-89: Allocates no more unneeded memory for text    [fbs]
  21.  :History.      07-May-89: Allocates even less memory now                [fbs]
  22.  :History.      14-May-89: Removed deadlock-bug with Find-Window         [fbs]
  23.  :History. V1.5 25-May-89: Added print feature                           [fbs]
  24.  :History.      25-May-89: Removed all imports (apart from Arts)         [fbs]
  25.  :History.      26-May-89: inspired by J. Kupfer, I added nk 5 to quit   [fbs]
  26.  :History.      26-May-89: Now handle BS correctly                       [fbs]
  27.  :History. V1.6 02-Jul-89: Now supports several fontstyles and colors    [fbs]
  28.  :History. V1.7 03-Jul-89: Is again as fast as it was with 2 colors      [fbs]
  29.  :History.      03-Jul-89: Now no more crashes when quitting while print [fbs]
  30.  :History.      07-Jul-89: removed bug with texts of length 0            [fbs]
  31.  :History. V1.8 10-Jul-89: small bug in find-command removed             [fbs]
  32.  :History.      10-Jul-89: now found strings are highlighted             [fbs]
  33.  :History.      14-Jul-89: nk0 to display fileinfo                       [fbs]
  34.  :History. V2.0 06-Aug-89: Ported this to OBERON                         [fbs]
  35.  :History.      06-Aug-89: Added ARP-FileRequester                       [fbs]
  36.  :History.      07-Aug-89: Added L - (load new file) Command             [fbs]
  37.  :History. V2.1 03-Sep-89: no more gurus if an r/w error occures         [fbs]
  38.  :History.      03-Sep-89: MM used to execute CSI-Codes backwards. fixed [fbs]
  39.  :History.      03-Sep-89: ping / pong with Shift+Fn / Fn                [fbs]
  40.  :History.      03-Sep-89: new command: goto                             [fbs]
  41.  :History. V2.2 05-Sep-89: will run with any keymapping now              [fbs]
  42.  :History. V2.3 17-Sep-89: New command: sleep & Pop-Up feature           [fbs]
  43.  :History.      17-Sep-89: "MuchMore -s" will go to sleep immediately    [fbs]
  44.  :History.      17-Sep-89: Interprets <CSI>m as <CSI>0m now              [fbs]
  45.  :History. V2.4 17-Sep-89: New command: write block "w"                  [fbs]
  46.  :History.      17-Sep-89: rewritten argument parser to allow quotes     [fbs]
  47.  :History. V2.5 18-Sep-89: now uses the 8x8 font set with SetFont        [fbs]
  48.  :History.      19-Sep-89: no more scatters memory. Allocates 4K Chunks  [fbs]
  49.  :History.      07-Jun-90: Neu MuchMorePoPa unterstützt PowerPacker-Texte[fbs]
  50.  :History. V2.6 26-Jun-90: Made MuchMore reentrant                       [fbs]
  51.  :History.      26-Jun-90: Opens 1-Plane Screen if memory is rare        [fbs]
  52.  :History.      26-Jun-90: Asynchronus fast scrolling with Ctrl-Up/Down  [fbs]
  53.  :History.      26-Jun-90: Now supports interlaced screens               [fbs]
  54.  :History.      08-Aug-90: CLI-Option '-l' to toggle interlaced mode     [fbs]
  55.  :History. V2.7 09-Aug-90: no more RethinkDisplay()s,looks good with 2.0 [fbs]
  56.  :History.      10-Aug-90: Supports Kick2.0 ASL-FileRequester            [fbs]
  57.  :History.      12-Aug-90: tempfile wasn't delete some times. now ok.    [fbs]
  58.  :Contents.     A Soft-Scrolling ASCII-File Printer.
  59.  :Usage.        MuchMorePoPa {-s|-l} [Text]
  60.  :Remark.       Compile: 'Oberon -dm MuchMorePoPa'
  61.  :Remark.       Link:    'OLink -dm MuchMorePoPa OBJ MMQText.obj OBJ MMInput.obj OBJ PPData.o'
  62. ---------------------------------------------------------------------------*)
  63.  
  64. MODULE MuchMorePoPa;
  65.  
  66. (* $StackChk- $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  67.  
  68. IMPORT ol: OberonLib,
  69.        d:  Dos,
  70.        e:  Exec,
  71.            Input,
  72.        ie: InputEvent,
  73.        I:  Intuition,
  74.        g:  Graphics,
  75.        wb: Workbench,
  76.        km: KeyMap,
  77.        sys:SYSTEM;
  78.  
  79. (*-------------------------------------------------------------------------*)
  80.  
  81. CONST
  82.   empty = "";
  83.   oom = "Out of memory!";
  84.   cof = "Can't open file!";
  85.   usage = "Usage: MuchMorePoPa {-s|-l} [Text]";
  86.   rwerr = "Read/Write Error";
  87.   noarp = "Need arp for FileReq";
  88.   conerr = "Console problem";
  89.   MuchText = "MuchMorePoPa V2.7 © 1990 AMOK";
  90.   MMissleeping = "MM is sleeping";
  91.   MMisawake = "MM is awake";
  92.   nil = "NIL:";
  93.   w = TRUE;
  94.   f = FALSE;
  95.   MaxLen = 256;
  96.  
  97. (* Control codes for QText: *)
  98.   plain    = CHR(17);
  99.   italic   = CHR(18);
  100.   bold     = CHR(19);
  101.   boldit   = CHR(20);
  102.   ulineon  = CHR(21);
  103.   ulineoff = CHR(22);
  104.  
  105.   Italic = 0;
  106.   Bold   = 1;
  107.   Ulin   = 2;
  108.   Inv    = 3;
  109.  
  110.  
  111. TYPE
  112.   TextLinePtr = POINTER TO TextLine;
  113.   TextLine = STRUCT
  114.                next: TextLinePtr;
  115.                prev: TextLinePtr;
  116.                len:  INTEGER;
  117.                size: INTEGER;
  118.                text: ARRAY MaxLen+1 OF CHAR;
  119.              END;
  120.   String = ARRAY 256 OF CHAR;
  121.   StringPtr = POINTER TO String;
  122.   FontData = ARRAY 8, 192, 8 OF CHAR;
  123.   FontDataPtr = POINTER TO FontData;
  124.  
  125.  
  126. CONST
  127. (* FileReqFlags *)
  128.   listFunc    = 0;
  129.   gEventFunc  = 1;
  130.   addGadFunc  = 2;
  131.   newWindFunc = 3;
  132.   newIDCMP    = 4;
  133.   doColor     = 5;
  134.   doMsgFunc   = 6;
  135.   doWildFunc  = 7;
  136.  
  137. TYPE
  138.   STRPTR = POINTER TO CHAR;
  139.  
  140.   FileRequesterPtr = POINTER TO FileRequester;
  141.   FileRequester = STRUCT
  142.     hail: STRPTR;                (* Hailing text                     *)
  143.     ddef: StringPtr;             (* Filename array (FCHARS+1)        *)
  144.     ddir: StringPtr;             (* Directory array (DSIZE+1)        *)
  145.     wind: I.WindowPtr;           (* Window requesting or NULL        *)
  146.     funcFlags: SHORTSET;         (* Control. See above.              *)
  147.     reserved1: SHORTINT;         (* Set this to 0                    *)
  148.     function: PROCEDURE;         (* Your function, see btdef's       *)
  149.     reserved2: LONGINT;          (* reserved                         *)
  150.   END;
  151.  
  152.  
  153. VAR
  154.   Screen: I.ScreenPtr;           (* Screen that contains the Text     *)
  155.   BM: g.BitMapPtr;               (* Screen's BitMap (external)        *)
  156.   Window: I.WindowPtr;           (* My window                         *)
  157.   MyFont: g.TextAttr;            (* Topaz 8                           *)
  158.   MyFile: d.FileHandlePtr;       (* For loading Textfile              *)
  159.   FirstLine: TextLinePtr;        (* Saved Text                        *)
  160.   TopLine: TextLinePtr;          (* Points to topmost Line            *)
  161.   BottomLine: TextLinePtr;       (* Last Line displayed on Screen     *)
  162.   LoadLine: TextLinePtr;         (* currently loaded Line             *)
  163.   LastLine: TextLinePtr;         (* Last element of LineList          *)
  164.   Name,OldName: String;          (* Text's Name                       *)
  165.   lace: BOOLEAN;                 (* use interlaced screen?            *)
  166.   IStr,PStr: String;             (* differently used                  *)
  167.   Buffer: ARRAY 512 OF CHAR;     (* Buffer for Reading                *)
  168.   RQPos: LONGINT;                (* Position within ReadBuffer        *)
  169.   RQLen: LONGINT;                (* Number of CHARs in Buffer         *)
  170.   NumLines: INTEGER;             (* Number of Lines on Screen         *)
  171.   NumColumns: INTEGER;           (* Number of Columns on Screen       *)
  172.   PageSize: LONGINT;             (* 8*NumLines*NumColumns             *)
  173.   AnzLines: LONGINT;             (* Length of Text in Lines           *)
  174.   fontdata: FontData;            (* Fonts used by QText()             *)
  175.   MyLock,OldDir: d.FileLockPtr;  (* To Examine and Load File          *)
  176.   FileInfo: d.FileInfoBlockPtr;  (* to get File's length              *)
  177.   FileLength,TextLength: LONGINT;(* Length of File and of Displayed Text *)
  178.   ScreenPos: INTEGER;            (* actual position within bitmap     *)
  179.   ShowTask: e.Task;              (* the task that displays the text   *)
  180.   ShowStack: ARRAY 1000 OF LONGINT; (* it's stack                        *)
  181.   ShowTaskRunning: BOOLEAN;      (* is Showtask activated?            *)
  182.   mySigBit: INTEGER;             (* My SignalBit                      *)
  183.   mySig: LONGSET;                (* My SignalSet = LONGSET{mySigBit}  *)
  184.   SignalNewData: BOOLEAN;        (* Signal when new data is loaded    *)
  185.   SignalAllRead: BOOLEAN;        (* send signal at end of text        *)
  186.   Done: BOOLEAN;                 (* Quit                              *)
  187.   print: BOOLEAN;                (* print text                        *)
  188.   NewText: BOOLEAN;              (* load new text                     *)
  189.   Me: d.ProcessPtr;              (* my main task                      *)
  190.   Info: BOOLEAN;                 (* is info currently displayed ?     *)
  191.   MyMsgPtr: I.IntuiMessagePtr;   (* for receiving Messages            *)
  192.   i,j: INTEGER;                  (* count                             *)
  193.   Scroll: BOOLEAN;               (* scrolling or waiting?             *)
  194.   Fast: BOOLEAN;                 (* scrollquick?                      *)
  195.   Sync: BOOLEAN;                 (* scroll very quick?                *)
  196.   in,out: d.FileHandlePtr;       (* i/o for TYPE xxx TO PRT:          *)
  197.   fg,bg: INTEGER;                (* Text colors                       *)
  198.   style: SHORTSET;               (* Text style                        *)
  199.   CommLine: POINTER TO CHAR;     (* The CLI-commands                  *)
  200.   ArgPtr: POINTER TO String;     (* to get WBArg                      *)
  201.   wbm: wb.WBStartupPtr;          (* WBenchMessage                     *)
  202.   ri: g.RasInfoPtr;              (* Screen's ViewPort's RasInfo       *)
  203.   NuScreen: I.NewScreen;         (* to open screens                   *)
  204.   NuWindow: I.NewWindow;         (* to open window                    *)
  205.   Prefs: I.Preferences;          (* Preferences (need wbLace)         *)
  206.   StrGadget: I.Gadget;           (* Gadget for Find-Command           *)
  207.   StrInfo: I.StringInfo;         (* its special info                  *)
  208.   arp: LONGINT;                  (* ArpBase                           *)
  209.   asl: LONGINT;                  (* ASL-librarybase                   *)
  210.   body,text,ok: I.IntuiText;     (* IntuiTexts for AutoRequest        *)
  211.   FR: FileRequester;             (* The Requester                     *)
  212.   Filename: String;              (* The Filename (without path)       *)
  213.   Dirname: String;               (* its path                          *)
  214.   NewDisp: BOOLEAN;              (* need to rebuild Display ?         *)
  215.   TextMarkers: ARRAY 10 OF TextLinePtr; (* Marked Positions in text   *)
  216.   FindLine: TextLinePtr;         (* Last found line                   *)
  217.   KeyMap: ARRAY 40H OF CHAR;     (* console's KeyMap                  *)
  218.   wreq: e.IOStdReq;              (* Request to communicate with the console *)
  219.   console: e.DevicePtr;          (* the console.device                *)
  220.   ievent: ie.InputEvent;         (* InputEvent to convert keycodes    *)
  221.  
  222.   InputData: STRUCT
  223.     wakeUpSignal: SHORTINT;      (* Signal that's wakes us up*)
  224.     sigTask: e.TaskPtr;          (* MM's main task                    *)
  225.     sleeping: BOOLEAN;           (* TRUE while we sleep               *)
  226.   END;
  227.   InputDevPort: e.MsgPort;       (* Input.Device's Port               *)
  228.   InputRequestBlock: e.IOStdReq; (* its Requestblock                  *)
  229.   HandlerStuff: e.Interrupt;     (* contains data about Input Handler *)
  230.   InputOpen: BOOLEAN;            (* TRUE while input.device is open   *)
  231.   HandlerActive: BOOLEAN;        (* TRUE while InputHandler is active *)
  232.  
  233.   WriteName: String;             (* File to write Block               *)
  234.   savefrom,savesize: LONGINT;    (* How much to save?                 *)
  235.   save: BOOLEAN;                 (* save block                        *)
  236.   buffer: POINTER TO LONGINT;    (* buffer to save file               *)
  237.  
  238.   c: CHAR;                       (* \ used by GetTextLine();          *)
  239.   le: INTEGER;                   (* / global for speed                *)
  240.  
  241.   DeCrunched: BOOLEAN;
  242.   decrnw: I.NewWindow;
  243.   decrwin: I.WindowPtr;
  244.  
  245. (*------  Memory:  ------*)
  246.  
  247. CONST ChunkSize = 4096;          (* size of allocated chunks *)
  248.  
  249. TYPE
  250.   MemChunkPtr = POINTER TO MemChunk;  (* chunklist *)
  251.   MemChunk = STRUCT
  252.                prev: MemChunkPtr;     (* link *)
  253.                data: ARRAY ChunkSize OF BYTE; (* ChinkSize Bytes of memory *)
  254.              END;
  255.  
  256. VAR
  257.   MemIndex: INTEGER;      (* index in current Chunk *)
  258.   CurChunk: MemChunkPtr;  (* current chunk          *)
  259.  
  260. (*-----------------  External Assembler Procedures:  ----------------------*)
  261.  
  262.  
  263. (*------  The fastest textoutput-Procedure in the world (maybe):  ------*)
  264.  
  265. PROCEDURE QText{"QText"}(y{1}: INTEGER;
  266.                          str{8}: LONGINT;
  267.                          bm{9}: g.BitMapPtr;
  268.                          fd{10}: FontDataPtr);
  269.  
  270. (*------  Get Font:  ------*)
  271.  
  272. PROCEDURE GetFontData{"GetFontData"}(from{8},to{9}: LONGINT; linelen{7}: INTEGER);
  273.  
  274. (*------  Copy Line:  ------*)
  275.  
  276. PROCEDURE CopyLine1{"CopyLine1"}(bm{8}: g.BitMapPtr; w{0},h{1},pos{2}: INTEGER);
  277.  
  278. PROCEDURE CopyLine2{"CopyLine2"}(bm{8}: g.BitMapPtr; w{0},h{1},pos{2}: INTEGER);
  279.  
  280.  
  281. (*------  Input Handler:  ------*)
  282.  
  283. PROCEDURE * InputHandler{"MMInputHandler"};
  284.  
  285.  
  286. (*-------------------------------------------------------------------------*)
  287.  
  288. (*------  Console Procedure:  ------*)
  289.  
  290.  
  291. PROCEDURE RawKeyConvert{console,-48}(events{8}:ie.InputEventPtr;
  292.                                      buffer{9}:LONGINT;
  293.                                      length{1}:LONGINT;
  294.                                      keyMap{10}:LONGINT);
  295.  
  296.  
  297. (*-------------------------------------------------------------------------*)
  298.  
  299.  
  300. PROCEDURE Length(VAR s: String): INTEGER;
  301. VAR l: INTEGER;
  302. BEGIN l := -1; REPEAT INC(l) UNTIL (l>sys.SIZE(s)) OR (s[l]=0X); RETURN l;
  303. END Length;
  304.  
  305.  
  306. PROCEDURE Append(VAR s1: String; s2: StringPtr);
  307. (* appends s2 to s1 *)
  308. VAR p,q: INTEGER;
  309. BEGIN
  310.   p := Length(s1); q := 0;
  311.   WHILE (p<=sys.SIZE(s1)) AND (s2^[q]#0X) AND (p<NumColumns) DO
  312.     s1[p] := s2^[q]; INC(p); INC(q)
  313.   END;
  314.   IF p<=sys.SIZE(s1) THEN s1[p] := 0X END;
  315. END Append;
  316.  
  317.  
  318. (*-----------------------------  Requester:  ------------------------------*)
  319.  
  320.  
  321. PROCEDURE Request(Text: StringPtr);
  322.  
  323. VAR
  324.   out: d.FileHandlePtr;
  325.   c: CHAR;
  326.  
  327. BEGIN
  328.   IF ol.wbStarted THEN
  329.     body.frontPen := 0; body.backPen  := 1;  body.drawMode := g.jam2;
  330.     body.leftEdge := 12; body.topEdge  := 8;
  331.     text := body; ok := body;
  332.     body.iText    := sys.ADR(MuchText);
  333.     body.nextText := sys.ADR(text);
  334.     text.iText    := Text; text.topEdge := 22;
  335.     ok.leftEdge   := 6; ok.topEdge := 3; ok.iText := sys.ADR("  OK  ");
  336.     sys.SETREG(0,I.AutoRequest(NIL,sys.ADR(body),NIL,sys.ADR(ok),
  337.                            LONGSET{I.rawKey},LONGSET{},320,65));
  338.   ELSE
  339.     out := d.Output();
  340.     sys.SETREG(0,d.Write(out,Text^,Length(Text^)));
  341.     c := 0AX;
  342.     sys.SETREG(0,d.Write(out,c,1));
  343.   END;
  344.   HALT(0);
  345. END Request;
  346.  
  347. (*-------------------------------------------------------------------------*)
  348.  
  349. (*-------------------------------------------------------------------------*)
  350.  
  351. (********************************************************************
  352. *                                                                   *
  353. *  'PP_LoadData' PowerPacker DATA file support function V1.1        *
  354. *                                                                   *
  355. *  You may use this code for non-commercial purposes provided this  *
  356. *  copyright notice is left intact !                                *
  357. *                                                                   *
  358. *                          Copyright (c) Aug 1989 by Nico François  *
  359. ********************************************************************)
  360.  
  361. PROCEDURE LoadData*(    file: ARRAY OF CHAR;
  362.                     VAR buffer: e.ADDRESS;
  363.                     VAR length: LONGINT): BOOLEAN;
  364.  
  365. CONST
  366.   SAFETYMARGIN = 64;
  367.  
  368. VAR
  369.   handle: d.FileHandlePtr;
  370.   lock: d.FileLockPtr;
  371.   ap,filestart: POINTER TO BYTE;
  372.   bufferlen: LONGINT;
  373.  
  374.   hdr: LONGINT;
  375.   filelen,crunlen,efficiency: LONGINT;
  376.  
  377. CONST
  378.   PX20 = sys.VAL(LONGINT,'PX20');
  379.   PP11 = sys.VAL(LONGINT,'PP11');
  380.   PP20 = sys.VAL(LONGINT,'PP20');
  381.  
  382.  
  383.   PROCEDURE myRead(VAR t: ARRAY OF BYTE): BOOLEAN;
  384.   BEGIN
  385.     RETURN d.Read(handle,t,LEN(t))#LEN(t);
  386.   END myRead;
  387.  
  388.   PROCEDURE DecrunchBuffer{"_pp_DecrunchBuffer"}(
  389.                                  endcrun{8}: e.ADDRESS;
  390.                                  buffer{9}: e.ADDRESS;
  391.                                  efficiency{0}: LONGINT);
  392.  
  393. BEGIN
  394.   lock := d.Lock(file,d.accessRead);
  395.   IF lock=NIL THEN RETURN FALSE END;
  396.   IF d.Examine(lock,FileInfo) THEN END;
  397.   d.UnLock(lock);
  398.   crunlen := FileInfo.size;
  399.   handle := d.Open(file,d.oldFile);
  400.   IF handle=NIL THEN RETURN FALSE END;
  401.   decrwin := NIL;
  402.   LOOP
  403.     IF myRead(hdr) THEN EXIT END;
  404.     IF (crunlen<=16) OR ((hdr#PP11) AND (hdr#PP20)) THEN EXIT END;
  405.     decrnw.leftEdge   := NumColumns*4-125;
  406.     decrnw.topEdge    := NumLines  *4- 5 + ri.ryOffset;
  407.     decrnw.blockPen   := 1;
  408.     decrnw.width      := 250;
  409.     decrnw.height     := 10;
  410.     decrnw.flags      := LONGSET{I.activate};
  411.     decrnw.screen     := Screen;
  412.     decrnw.type       := I.customScreen;
  413.     decrnw.title      := sys.ADR(" Decrunching ... please wait!");
  414.     decrwin := I.OpenWindow(decrnw);
  415.     IF decrwin=NIL THEN EXIT END;
  416.     IF d.Seek(handle,crunlen-4,d.beginning)=0 THEN END;
  417.     IF myRead(filelen) THEN EXIT END;
  418.     filelen := filelen DIV 256;
  419.     DEC(crunlen,8);
  420.     IF d.Seek(handle,4,d.beginning)=0 THEN END;
  421.     IF myRead(efficiency) THEN EXIT END;
  422.     bufferlen := filelen + SAFETYMARGIN;
  423.     ol.New(filestart,bufferlen);
  424.     IF filestart=NIL THEN EXIT END;
  425.     IF d.Read (handle,filestart^,crunlen) # crunlen THEN DISPOSE(filestart); EXIT END;
  426.     DecrunchBuffer(sys.VAL(LONGINT,filestart)+crunlen,
  427.                    sys.VAL(LONGINT,filestart)+SAFETYMARGIN,efficiency);
  428.     ap := sys.VAL(LONGINT,filestart)+SAFETYMARGIN;
  429.     e.CopyMem(ap^,filestart^,filelen);
  430.     buffer := filestart;
  431.     length := filelen;
  432.     IF decrwin#NIL THEN I.CloseWindow(decrwin) END;
  433.     d.Close(handle);
  434.     RETURN TRUE;
  435.   END;  (* LOOP *)
  436.   d.Close(handle);
  437.   IF decrwin#NIL THEN I.CloseWindow(decrwin) END;
  438.   RETURN FALSE;
  439. END LoadData;
  440.  
  441. (*-------------------------------------------------------------------------*)
  442.  
  443. PROCEDURE Decrunch;
  444.  
  445. VAR
  446.   buffer: POINTER TO BYTE;
  447.   length: LONGINT;
  448.   handle: d.FileHandlePtr;
  449.   i,j: INTEGER;
  450.   win: I.WindowPtr;
  451.  
  452. BEGIN
  453.   DeCrunched := FALSE;
  454.   IF LoadData(Name,buffer,length) THEN
  455.     OldName := Name;
  456.     i := Length(Name);
  457.     LOOP
  458.       DEC(i);
  459.       IF i<0 THEN EXIT END;
  460.       CASE OldName[i] OF "/",":": EXIT END;
  461.     END;
  462.     Name := "T:MMPP_"; j := 7;
  463.     REPEAT
  464.       INC(i);
  465.       Name[j] := OldName[i];
  466.       INC(j);
  467.     UNTIL OldName[i]=0X;
  468.     DeCrunched := TRUE;
  469.     win := Me.windowPtr; Me.windowPtr := -1;
  470.     handle := d.Open(Name,d.newFile);
  471.     IF handle=NIL THEN
  472.       REPEAT
  473.         DEC(j);
  474.         Name[j+2] := Name[j];
  475.       UNTIL j=0;
  476.       Name[0] := "R"; Name[1] := "A"; Name[2] := "M";
  477.       handle := d.Open(Name,d.newFile);
  478.     END;
  479.     IF handle#NIL THEN
  480.       IF d.Write(handle,buffer^,length)=0 THEN END;
  481.       d.Close(handle);
  482.     END;
  483.     Me.windowPtr := win;
  484.     DISPOSE(buffer);
  485.   END;
  486. END Decrunch;
  487.  
  488.  
  489. (*-------------------------------------------------------------------------*)
  490.  
  491. PROCEDURE AllocLine(sz: INTEGER): TextLinePtr;
  492.  
  493. VAR
  494.   a: TextLinePtr;
  495.   newchunk: MemChunkPtr;
  496.  
  497. BEGIN
  498.   INC(sz,sys.SIZE(TextLine)-MaxLen); IF ODD(sz) THEN INC(sz) END;
  499.   IF MemIndex+sz<=ChunkSize THEN     (* does mem fit into current chunk ? *)
  500.     INC(MemIndex,sz);                (* increment index in current chunk  *)
  501.   ELSE
  502.     NEW(newchunk);                   (* allocate new chunk                *)
  503.     IF newchunk=NIL THEN Request(sys.ADR(oom)) END;
  504.     newchunk.prev := CurChunk;       (* link chunk into list              *)
  505.     CurChunk := newchunk;
  506.     MemIndex := sz;
  507.   END;
  508.   RETURN sys.ADR(CurChunk.data[MemIndex-sz]);
  509. END AllocLine;
  510.  
  511.  
  512. PROCEDURE DisposeLines();
  513.  
  514. VAR chunk: MemChunkPtr;
  515.  
  516. BEGIN
  517.   WHILE CurChunk#NIL DO
  518.     chunk := CurChunk.prev;
  519.     DISPOSE(CurChunk);
  520.     CurChunk := chunk;
  521.   END;
  522.   MemIndex := ChunkSize;
  523. END DisposeLines;
  524.  
  525. (*-------------------------------------------------------------------------*)
  526.  
  527.  
  528. PROCEDURE MakeThink(sync: BOOLEAN);
  529.  
  530. BEGIN
  531.   I.MakeScreen(Screen);
  532.   g.MrgCop(I.ViewAddress());
  533.   IF sync THEN g.WaitBOVP(sys.ADR(Screen.viewPort)) END;
  534. END MakeThink;
  535.  
  536.  
  537. (*------  Clear Display:  ------*)
  538.  
  539.  
  540. PROCEDURE ClearBitMaps();
  541.  
  542. BEGIN
  543.   g.BltClear(BM.planes[0],2*PageSize,LONGSET{});
  544.   g.BltClear(BM.planes[1],2*PageSize,LONGSET{});
  545.   ScreenPos := 0;
  546.   ri.ryOffset := 0;
  547. END ClearBitMaps;
  548.  
  549.  
  550. (*------------------------  Open Display:  --------------------------------*)
  551.  
  552.  
  553. PROCEDURE InitScreen();
  554.  
  555. VAR c: CHAR;
  556.  
  557. BEGIN
  558.  
  559. (*------  Open Screen:  ------*)
  560.  
  561.   NumColumns := g.gfx.normalDisplayColumns DIV 32 * 4;
  562.   IF NumColumns>MaxLen THEN NumColumns := MaxLen END;
  563.   NuScreen.viewModes := {g.hires};
  564.   NumLines := g.gfx.normalDisplayRows DIV 8;
  565.   IF lace THEN
  566.     INC(NumLines,NumLines);
  567.     INCL(NuScreen.viewModes,g.lace);
  568.   END;
  569.   NuScreen.width  := 8*NumColumns;
  570.   PageSize := 8*LONG(NumLines*NumColumns);
  571.   NuScreen.height := 16*NumLines;
  572.   NuScreen.depth  := 2;
  573.   MyFont.name := sys.ADR("topaz.font");
  574.   MyFont.ySize := 8;
  575.   NuScreen.font := sys.ADR(MyFont);
  576.   NuScreen.type := I.customScreen+{I.screenQuiet};
  577.   LOOP
  578.     Screen := I.OpenScreen(NuScreen);
  579.     IF Screen#NIL THEN EXIT END;
  580.     DEC(NuScreen.depth);
  581.     IF NuScreen.depth=0 THEN Request(sys.ADR(oom)) END;
  582.   END;
  583.   BM := Screen.rastPort.bitMap;
  584.   IF NuScreen.depth=1 THEN BM.planes[1] := BM.planes[0] END;
  585.   ri := Screen.viewPort.rasInfo;
  586.   ClearBitMaps;
  587.   ri.ryOffset := 32;
  588.   Screen.height := Screen.height DIV 2;
  589.   MakeThink(TRUE);
  590.   I.RethinkDisplay;
  591.  
  592. (*------  Get Font:  ------*)
  593.  
  594.   IStr[64] := 0X;
  595.   j := 0; c := 20X;
  596.   g.SetDrMd(sys.ADR(Screen.rastPort),g.jam1);
  597.   g.SetAPen(sys.ADR(Screen.rastPort),1);
  598.   WHILE j<32 DO
  599.     i := 0; WHILE i<48 DO IStr[i] := c; INC(i); INC(c) END;
  600.     IF c=80X THEN c := 0A0X END;
  601.     g.Move(sys.ADR(Screen.rastPort),0,Screen.rastPort.font.baseline+j);
  602.     g.Text(sys.ADR(Screen.rastPort),IStr,48);
  603.     INC(j,8);
  604.   END;
  605.   GetFontData(Screen.bitMap.planes[0],sys.ADR(fontdata),NumColumns);
  606.  
  607. (*------  Open Window:  ------*)
  608.  
  609.   NuWindow.flags  := LONGSET{I.rmbTrap,I.activate,I.borderless,I.reportMouse};
  610.   NuWindow.screen := Screen;
  611.   NuWindow.type   := I.customScreen;
  612.   NuWindow.topEdge:= 10;
  613.   NuWindow.width  := NuScreen.width;
  614.   NuWindow.height := Screen.height-10;
  615.   NuWindow.idcmpFlags := LONGSET{I.inactiveWindow,I.activeWindow,I.rawKey,
  616.                                  I.mouseButtons};
  617.   Window := I.OpenWindow(NuWindow);
  618.   IF Window=NIL THEN Request(sys.ADR(oom)) END;
  619.  
  620. END InitScreen;
  621.  
  622.  
  623. (*-------------------------------------------------------------------------*)
  624.  
  625. PROCEDURE CloseDisplay();
  626.  
  627. BEGIN
  628.   IF Window#NIL THEN I.CloseWindow(Window); Window := NIL END;
  629.   IF Screen#NIL THEN I.CloseScreen(Screen); Screen := NIL END;
  630. END CloseDisplay;
  631.  
  632. (*------  Read one TextLine into a Variable:  ------*)
  633.  
  634.  
  635. PROCEDURE GetTextLine(): TextLinePtr;
  636. (* returns NIL at EOF *)
  637.  
  638. VAR
  639.   l: TextLinePtr;
  640.   sz,wd,i,j: INTEGER;
  641.   txt: ARRAY MaxLen+1 OF CHAR;
  642.   num: ARRAY 10 OF INTEGER;
  643.   newcol: BOOLEAN;
  644.   oldstyle: SHORTSET;
  645.  
  646.   PROCEDURE GetCh();
  647.  
  648.   BEGIN
  649.     IF RQPos=RQLen THEN
  650.       RQLen := d.Read(MyFile,Buffer,sys.SIZE(Buffer));
  651.       IF RQLen<0 THEN Request(sys.ADR(rwerr)) END;
  652.       RQPos := 0;
  653.     END;
  654.     IF RQLen=0 THEN c := 0X ELSE
  655.       c := Buffer[RQPos]; IF c=0X THEN c:=1X END;
  656.       INC(RQPos); INC(le);
  657.     END;
  658.   END GetCh;
  659.  
  660. BEGIN
  661.   IF RQLen=0 THEN RETURN NIL END;
  662.   sz := 0; wd := 0; le := 0;
  663.   IF Italic IN style THEN IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END; INC(sz);
  664.                      ELSE IF Bold IN style THEN txt[sz] := bold; INC(sz) END;
  665.   END;
  666.   IF Ulin IN style THEN txt[sz] := ulineon; INC(sz) END;
  667.   IF    Inv IN style     THEN txt[sz] := CHR(fg+4*bg+1); INC(sz)
  668.   ELSIF (fg#1) OR (bg#0) THEN txt[sz] := CHR(bg+4*fg+1); INC(sz) END;
  669.   LOOP
  670.     LOOP
  671.       GetCh;
  672.       IF sys.VAL(CHAR,sys.VAL(SHORTSET,c)*SHORTSET{0..6})#1BX THEN EXIT END;
  673.       i := -1;
  674.       REPEAT
  675.         GetCh;
  676.         IF (c>=30X) AND (c<=39X) THEN
  677.           INC(i); num[i] := 0;
  678.           REPEAT
  679.             num[i] := 10*num[i]+ORD(c)-ORD(30X); GetCh;
  680.           UNTIL (c<30X) OR (c>39X);
  681.         END;
  682.         c := CAP(c);
  683.       UNTIL (c>=3FX(*"?"*)) AND (c<=5AX) OR (c=0X) OR (i=9);
  684.       IF c=4DX THEN
  685.         newcol := f; oldstyle := style; j := 0;
  686.         IF i=-1 THEN i:=0; num[0] := 0 END;
  687.         WHILE (i>=j) AND (sz<MaxLen-1) DO
  688.           CASE num[j] OF
  689.           0: style := SHORTSET{}; fg := 1; bg := 0; newcol := w |
  690.           1: INCL(style,Bold) |
  691.           2: fg := 2; newcol := w (* I hope this is correct *) |
  692.           3: INCL(style,Italic) |
  693.           4: INCL(style,Ulin) |
  694.           7: INCL(style,Inv); newcol := w |
  695.           30..37: fg := sys.VAL(INTEGER,sys.VAL(SET,num[j]-30) * {0,1}); newcol := w |
  696.           40..47: bg := sys.VAL(INTEGER,sys.VAL(SET,num[j]-40) * {0,1}); newcol := w |
  697.           ELSE END;
  698.           INC(j);
  699.         END;
  700.         IF (oldstyle#style) AND (sz<MaxLen) THEN
  701.           IF Italic IN style THEN IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END;
  702.                              ELSE IF Bold IN style THEN txt[sz] := bold   ELSE txt[sz] := plain  END;
  703.           END;
  704.           INC(sz);
  705.           IF (Ulin IN style) THEN
  706.             IF NOT((Ulin IN oldstyle)) AND (sz<MaxLen) THEN
  707.               txt[sz] := ulineon;
  708.               INC(sz);
  709.             END;
  710.           ELSE
  711.             IF (Ulin IN oldstyle) AND (sz<MaxLen) THEN
  712.               txt[sz] := ulineoff;
  713.               INC(sz);
  714.             END;
  715.           END;
  716.         END;
  717.         IF newcol AND (sz<MaxLen) THEN
  718.           IF Inv IN style THEN txt[sz] := CHR(fg+4*bg+1)
  719.                           ELSE txt[sz] := CHR(bg+4*fg+1) END;
  720.           INC(sz);
  721.         END;
  722.       END;   (* IF c="m" THEN *)
  723.     END;   (* LOOP *)
  724.     CASE c OF
  725.     20X..7FX:              txt[sz] := c; INC(sz); INC(wd) |
  726.     0A1X..0FFX: DEC(c,32); txt[sz] := c; INC(sz); INC(wd) |
  727.     8X: (* BS *)       IF wd>0 THEN DEC(sz); DEC(wd); END |
  728.     9X: (* TAB *)
  729.       REPEAT
  730.         txt[sz] := 20X; INC(sz); INC(wd)
  731.       UNTIL (sz=MaxLen) OR (wd=NumColumns) OR (sys.VAL(SET,sz)*{0..2}={}) |
  732.     0A0X:                txt[sz] := 20X; INC(sz); INC(wd) |
  733.     0AX,0X,0CX: EXIT |
  734.     ELSE END;
  735.     IF (wd>=NumColumns) OR (sz>=MaxLen) THEN EXIT END;
  736.   END;
  737.   l := AllocLine(sz);
  738.   l.len := le; l.size:= sz;
  739.   WHILE sz>0 DO DEC(sz); l.text[sz]:=txt[sz] END;
  740.   RETURN l;
  741. END GetTextLine;
  742.  
  743.  
  744. (*------  Write Line at Bottom of Text:  ------*)
  745.  
  746.  
  747. PROCEDURE AddBottomLine(Line: TextLinePtr; Fast: BOOLEAN);
  748.  
  749. VAR
  750.   i,j: INTEGER;
  751.   trash: LONGINT;
  752.   s1,d1,s2,d2: POINTER TO LONGINT;
  753.   a: LONGINT;
  754.  
  755. BEGIN
  756.   QText(8*(ScreenPos+NumLines),sys.ADR(Line.text),BM,sys.ADR(fontdata));
  757.   IF Fast THEN
  758.     INC(ri.ryOffset,8);
  759.     MakeThink(Sync);
  760.     CopyLine1(BM,NumColumns,NumLines,ScreenPos);
  761.   ELSE
  762.     a := 8*LONG(ScreenPos*NumColumns);
  763.     d1 := BM.planes[0] + a; s1 := sys.VAL(LONGINT,d1) + PageSize;
  764.     d2 := BM.planes[1] + a; s2 := sys.VAL(LONGINT,d2) + PageSize;
  765.     i := 8;
  766.     REPEAT
  767.       INC(ri.ryOffset);
  768.       IF NOT lace OR ODD(i) THEN MakeThink(TRUE) END;
  769.       j := NumColumns DIV 4;
  770.       REPEAT
  771.         d1^ := s1^; INC(d1,4); INC(s1,4);
  772.         d2^ := s2^; INC(d2,4); INC(s2,4);
  773.         DEC(j);
  774.       UNTIL j=0;
  775.       DEC(i);
  776.     UNTIL i=0;
  777.   END;
  778.   INC(ScreenPos);
  779.   IF ScreenPos=NumLines THEN
  780.     ScreenPos := 0;
  781.     ri.ryOffset := 0;
  782.   END;
  783. END AddBottomLine;
  784.  
  785.  
  786. (*------  Write String to Screen:  ------*)
  787.  
  788.  
  789. PROCEDURE Write(String: StringPtr; Fast: BOOLEAN);
  790.  
  791. VAR text: TextLine;
  792.  
  793. BEGIN
  794.   text := FirstLine^;
  795.   i := Length(String^);
  796.   IF i>=NumColumns THEN i := NumColumns-1 END;
  797.   text.text[i+1] := 0X;
  798.   REPEAT
  799.     text.text[i] := String^[i];
  800.     IF text.text[i]>80X THEN DEC(text.text[i],32) END;
  801.     DEC(i)
  802.   UNTIL i<0;
  803.   AddBottomLine(sys.ADR(text),Fast);
  804. END Write;
  805.  
  806.  
  807. (*------  Check whether BottomLine.next is NIL or not:  ------*)
  808.  
  809.  
  810. PROCEDURE TryBottomnext(): BOOLEAN;
  811. (* returns TRUE if BottomLine.next#NIL END; *)
  812.  
  813. BEGIN
  814.   IF (BottomLine.next=NIL) AND (MyFile#NIL) THEN
  815.     SignalNewData := w;
  816.     sys.SETREG(0,e.Wait(mySig));
  817.     SignalNewData := f;
  818.   END;
  819.   RETURN BottomLine.next#NIL;
  820. END TryBottomnext;
  821.  
  822.  
  823. (*------  Scroll down one Line:  ------*)
  824.  
  825.  
  826. PROCEDURE ScrollDown(Fast: BOOLEAN);
  827.  
  828. BEGIN
  829.   IF TryBottomnext() THEN
  830.     BottomLine := BottomLine.next;
  831.     INC(AnzLines);
  832.     INC(TextLength,BottomLine.len);
  833.   ELSE RETURN END;
  834.   IF AnzLines>=NumLines THEN TopLine := TopLine.next END;
  835.   AddBottomLine(BottomLine,Fast);
  836. END ScrollDown;
  837.  
  838.  
  839. (*------  Scroll Up one Line:  ------*)
  840.  
  841.  
  842. PROCEDURE ScrollUp(Fast: BOOLEAN);
  843.  
  844. VAR
  845.   i,j: INTEGER;
  846.   s1,d1,s2,d2: POINTER TO LONGINT;
  847.   a: LONGINT;
  848.  
  849. BEGIN
  850.   IF (TopLine.prev#NIL) AND (TopLine.prev.prev#NIL) THEN
  851.     TopLine := TopLine.prev;
  852.     DEC(TextLength,BottomLine.len);
  853.     DEC(AnzLines);
  854.     BottomLine := BottomLine.prev;
  855.     IF ScreenPos=0 THEN
  856.       ri.ryOffset  := NumLines*8;
  857.       ScreenPos := NumLines-1;
  858.     ELSE
  859.       DEC(ScreenPos);
  860.     END;
  861.     QText(8*ScreenPos,sys.ADR(TopLine.prev.text),BM,sys.ADR(fontdata));
  862.     IF Fast THEN
  863.       DEC(ri.ryOffset,8);
  864.       MakeThink(Sync);
  865.       CopyLine2(BM,NumColumns,NumLines,ScreenPos);
  866.     ELSE
  867.       a := 8*LONG((ScreenPos+1)*NumColumns);
  868.       s1 := BM.planes[0] + a; d1 := sys.VAL(LONGINT,s1) + PageSize;
  869.       s2 := BM.planes[1] + a; d2 := sys.VAL(LONGINT,s2) + PageSize;
  870.       i := 8;
  871.       REPEAT
  872.         DEC(ri.ryOffset);
  873.         IF NOT lace OR ODD(i) THEN MakeThink(TRUE) END;
  874.         j := NumColumns DIV 4;
  875.         REPEAT
  876.           DEC(d1,4); DEC(s1,4); d1^ := s1^;
  877.           DEC(d2,4); DEC(s2,4); d2^ := s2^;
  878.           DEC(j);
  879.         UNTIL j=0;
  880.         DEC(i);
  881.       UNTIL i=0;
  882.     END;
  883.   END;   (* IF TopLine#NIL ... *)
  884. END ScrollUp;
  885.  
  886.  
  887. (*------  Undo last Write():  ------*)
  888.  
  889.  
  890. PROCEDURE DelLine();
  891.  
  892. VAR
  893.   i,j: INTEGER;
  894.   s1,d1,s2,d2: POINTER TO LONGINT;
  895.   a: LONGINT;
  896.   text: TextLine;
  897.  
  898. BEGIN
  899.   IF ScreenPos=0 THEN
  900.     ri.ryOffset  := NumLines*8;
  901.     ScreenPos := NumLines;
  902.   END;
  903.   DEC(ScreenPos);
  904.   IF TopLine.prev#NIL THEN
  905.     QText(8*ScreenPos,sys.ADR(TopLine.prev.text),BM,sys.ADR(fontdata));
  906.   ELSE
  907.     QText(8*ScreenPos,sys.ADR(FirstLine.text),BM,sys.ADR(fontdata));
  908.   END;
  909.   a := (LONG(ScreenPos)+1)*8*LONG(NumColumns);
  910.   s1 := BM.planes[0] + a; d1 := sys.VAL(LONGINT,s1) + PageSize;
  911.   s2 := BM.planes[1] + a; d2 := sys.VAL(LONGINT,s2) + PageSize;
  912.   i := 8;
  913.   REPEAT
  914.     DEC(ri.ryOffset);
  915.     IF NOT lace OR ODD(i) THEN MakeThink(TRUE) END;
  916.     j := NumColumns DIV 4;
  917.     REPEAT
  918.       DEC(d1,4); DEC(s1,4); d1^ := s1^;
  919.       DEC(d2,4); DEC(s2,4); d2^ := s2^;
  920.       DEC(j);
  921.     UNTIL j=0;
  922.     DEC(i);
  923.   UNTIL i=0;
  924. END DelLine;
  925.  
  926.  
  927. (*------  Convert Integer to String:  ------*)
  928.  
  929.  
  930. PROCEDURE IntToStr(VAR String: String;
  931.                        At,Chars: INTEGER;
  932.                        int: LONGINT);
  933.  
  934. VAR
  935.   Cnt: INTEGER;
  936.   Ziff: LONGINT;
  937.  
  938. BEGIN
  939.   INC(Chars,At);
  940.   IF (Length(String)<Chars) AND (sys.SIZE(String)>=Chars) THEN
  941.     String[Chars] := 0X
  942.   END;
  943.   REPEAT
  944.     DEC(Chars);
  945.     String[Chars] := CHR(int MOD 10 + ORD(30X)); int := int DIV 10;
  946.   UNTIL (Chars=At) OR (int=0);
  947.   WHILE Chars>At DO DEC(Chars); String[Chars] := 20X END;
  948. END IntToStr;
  949.  
  950.  
  951. (*-------------------------------------------------------------------------*)
  952.  
  953.  
  954. PROCEDURE GetLength(t: TextLinePtr);
  955.  
  956. BEGIN
  957.   TextLength := 0; AnzLines := 0;
  958.   WHILE t#NIL DO INC(AnzLines); INC(TextLength,t.len); t := t.prev END;
  959. END GetLength;
  960.  
  961.  
  962. (*-------------------------------------------------------------------------*)
  963.  
  964.  
  965. PROCEDURE NewDisplay();
  966. (* Zeichnet ab BottomLine neu *)
  967.  
  968. VAR
  969.   i: INTEGER;
  970.   l: TextLinePtr;
  971.  
  972. BEGIN
  973.   ClearBitMaps;
  974.   i := 1;
  975.   l := BottomLine;
  976.   WHILE (i<NumLines) AND (BottomLine.next#NIL) DO
  977.     BottomLine := BottomLine.next;
  978.     INC(i);
  979.   END;
  980.   WHILE (i<NumLines) AND (l.prev#NIL) DO l := l.prev; INC(i) END;
  981.   BottomLine := l;
  982.   GetLength(l);
  983.   Write(sys.ADR(empty),w);
  984.   AddBottomLine(BottomLine,w);
  985.   i := 1;
  986.   WHILE i<NumLines DO
  987.     TopLine := l;
  988.     ScrollDown(w);
  989.     INC(i);
  990.   END;
  991.   Scroll := f;
  992. END NewDisplay;
  993.  
  994.  
  995. (*-------------------------------------------------------------------------*)
  996.  
  997.  
  998. PROCEDURE * ShowProc;
  999.  
  1000. VAR
  1001.   l: TextLinePtr;
  1002.   Down: BOOLEAN;               (* Scroll-Direction                  *)
  1003.   End: BOOLEAN;                (* Quit next time Space is pressed ? *)
  1004.   i,j,k,m: INTEGER;
  1005.   MyMsg: I.IntuiMessage;       (* contains Message                  *)
  1006.   Shift: BOOLEAN;              (* Shifted Keystroke ?               *)
  1007.   Alt: BOOLEAN;                (* Altered Keystroke ?               *)
  1008.   win: I.WindowPtr;            (* window for Find & Goto            *)
  1009.   Find,FindStr: ARRAY 80 OF CHAR; (* findstring / capitalized findstring *)
  1010.   Goto: ARRAY 10 OF CHAR;      (* string containing goto line #  *)
  1011.   li: LONGINT;                 (* longint value of line to go to *)
  1012.   flen: INTEGER;               (* length of findstring *)
  1013.   HiText: TextLine;            (* Highlited textline *)
  1014.   OldHiText: TextLinePtr;      (* original, un-hilited text *)
  1015.   found: BOOLEAN;              (* TRUE, if find was successful *)
  1016.   chr: CHAR;                   (* converted keycode *)
  1017.  
  1018.  
  1019.   PROCEDURE WaitAllRead();
  1020.  
  1021.   BEGIN
  1022.     IF MyFile#NIL THEN
  1023.       SignalAllRead := w;
  1024.       sys.SETREG(0,e.Wait(mySig));
  1025.       SignalAllRead := f;
  1026.     END;
  1027.   END WaitAllRead;
  1028.  
  1029.  
  1030.   PROCEDURE HiLite(at,len: INTEGER);
  1031.   (* Hilites len chars of BottomLine.text starting at position at *)
  1032.  
  1033.   VAR
  1034.     c: INTEGER;
  1035.     col: CHAR;
  1036.  
  1037.   BEGIN
  1038.     OldHiText := BottomLine; HiText := OldHiText^; BottomLine := sys.ADR(HiText);
  1039.     IF at+len+2<MaxLen THEN
  1040.       c := 0; col := 5X;
  1041.       WHILE c<at DO
  1042.         IF HiText.text[c]<CHR(17) THEN col := HiText.text[c] END;
  1043.         INC(c);
  1044.       END;
  1045.       HiText.text[at] := CHR(17-ORD(col));
  1046.       c := at; INC(len,at);
  1047.       WHILE c<len DO
  1048.         HiText.text[c+1] := OldHiText.text[c];
  1049.         INC(c);
  1050.       END;
  1051.       HiText.text[c+1] := col;
  1052.       REPEAT
  1053.         HiText.text[c+2] := OldHiText.text[c];
  1054.         INC(c);
  1055.       UNTIL HiText.text[c-1]=0X;
  1056.     END;
  1057.     IF HiText.next#NIL THEN HiText.next.prev := sys.ADR(HiText) END;
  1058.     IF HiText.prev#NIL THEN HiText.prev.next := sys.ADR(HiText) END;
  1059.   END HiLite;
  1060.  
  1061.  
  1062.   PROCEDURE UnHiLite();
  1063.  
  1064.   BEGIN
  1065.     IF HiText.next#NIL THEN HiText.next.prev := OldHiText END;
  1066.     IF HiText.prev#NIL THEN HiText.prev.next := OldHiText END;
  1067.   END UnHiLite;
  1068.  
  1069.  
  1070.   PROCEDURE ChkBotNewDisp;
  1071.  
  1072.   VAR
  1073.     c: INTEGER;
  1074.     t: TextLinePtr;
  1075.  
  1076.   BEGIN
  1077.     IF NOT found THEN
  1078.       I.DisplayBeep(NIL);
  1079.       IF TopLine.prev=NIL THEN BottomLine := TopLine
  1080.                           ELSE BottomLine := TopLine.prev END;
  1081.     END;
  1082.     NewDisplay;
  1083.     IF found THEN UnHiLite END;
  1084.   END ChkBotNewDisp;
  1085.  
  1086.  
  1087.   PROCEDURE Search(): BOOLEAN;
  1088.   (* searches string and hilites it if found. result is TRUE if string found *)
  1089.  
  1090.   BEGIN
  1091.     i := 0;
  1092.     IF BottomLine.len<NumColumns THEN m := BottomLine.len ELSE m := NumColumns END;
  1093.     WHILE i<BottomLine.size DO
  1094.       j := 0; k := i;
  1095.       WHILE CAP(BottomLine.text[k])=FindStr[j] DO
  1096.         INC(j); INC(k);
  1097.         IF FindStr[j]=0X THEN
  1098.           sys.SETREG(0,TryBottomnext());
  1099.           FindLine := BottomLine;
  1100.           HiLite(k-flen,flen);
  1101.           found := w; RETURN w;
  1102.         END;
  1103.       END;
  1104.       INC(i);
  1105.     END;
  1106.     RETURN f;
  1107.   END Search;
  1108.  
  1109.  
  1110.   PROCEDURE DisplayInfo();
  1111.  
  1112.   BEGIN
  1113. (* File: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines *)
  1114.     IStr := "XFile: "; IStr[0] := 7X;
  1115.     Append(IStr,sys.ADR(Name));
  1116.     Append(IStr,sys.ADR("                              "));
  1117.     IStr[36] := 0X;
  1118.     Append(IStr,sys.ADR("xxx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines"));
  1119.     IntToStr(IStr,36,3,TextLength * 100 DIV FileLength);
  1120.     IntToStr(IStr,43,6,TextLength);
  1121.     IntToStr(IStr,53,6,FileLength);
  1122.     IntToStr(IStr,67,6,AnzLines-1);
  1123.     i := 79;
  1124.     REPEAT IStr[i] := 20X; INC(i) UNTIL (i>=255) OR (i>=NumColumns+2);
  1125.     IStr[i] := 0X; Write(sys.ADR(IStr),f);
  1126.     Info := w;
  1127.   END DisplayInfo;
  1128.  
  1129.   PROCEDURE GetString(VAR str: ARRAY OF CHAR; int: BOOLEAN);
  1130.  
  1131.   BEGIN
  1132.     INC(Screen.height,Screen.height);
  1133.     I.MakeScreen(Screen);
  1134.     NuWindow.leftEdge    := 100;
  1135.     NuWindow.topEdge     := NumLines*4-6+ri.ryOffset;
  1136.     NuWindow.width       := NuScreen.width-200;
  1137.     NuWindow.height      := 12;
  1138.     NuWindow.blockPen    := 1;
  1139.     NuWindow.idcmpFlags  := LONGSET{I.inactiveWindow,I.gadgetUp};
  1140.     NuWindow.flags       := LONGSET{I.rmbTrap,I.activate};
  1141.     NuWindow.firstGadget := sys.ADR(StrGadget);
  1142.     NuWindow.screen      := Screen;
  1143.     NuWindow.type        := I.customScreen;
  1144.     StrGadget.leftEdge   := 2;
  1145.     StrGadget.topEdge    := 2;
  1146.     StrGadget.width      := NuWindow.width-4;
  1147.     StrGadget.height     := 8;
  1148.     StrGadget.activation := {I.stringCenter,I.relVerify};
  1149.     IF int THEN INCL(StrGadget.activation,I.longint) END;
  1150.     StrGadget.gadgetType := I.strGadget;
  1151.     StrGadget.specialInfo:= sys.ADR(StrInfo);
  1152.     StrInfo.buffer       := sys.ADR(str);
  1153.     StrInfo.maxChars     := LEN(str)-1;
  1154.     win := I.OpenWindow(NuWindow);
  1155.     IF win=NIL THEN RETURN END;
  1156.     REPEAT
  1157.       sys.SETREG(0,I.ActivateGadget(sys.ADR(StrGadget),win,NIL));
  1158.     UNTIL win.userPort.sigBit IN
  1159.            e.Wait(LONGSET{win.userPort.sigBit,
  1160.                           Window.userPort.sigBit});
  1161.     I.CloseWindow(win);
  1162.     Screen.height := Screen.height DIV 2;
  1163.   END GetString;
  1164.  
  1165.  
  1166.   PROCEDURE Help; (* executed when HELP or H is pressed *)
  1167.  
  1168.   BEGIN
  1169.     ClearBitMaps();
  1170.     Write(sys.ADR("\x13           \x15  MuchMorePoPa V2.7 Commands:  "),w);
  1171.     Write(sys.ADR(empty),w);
  1172.     Write(sys.ADR(" \x0dSpace\x05,\x0d LMB\x05:         Start / Stop scrolling. Quit at end of file."),w);
  1173.     Write(sys.ADR(" \x0dBackSpace\x05,\x0d RMB\x05:     Start / Stop scrolling backwards."),w);
  1174.     Write(sys.ADR(" \x0dUp\x05/\x0dDown\x05:            Move one line \x0dup\x05 or \x0ddown\x05."),w);
  1175.     Write(sys.ADR(" \x0dShift \x05+\x0d Up\x05/\x0dDn\x05:      Start / Stop quick scrolling \x0dup\x05 or \x0ddown\x05."),w);
  1176.     Write(sys.ADR(" \x0dAlt\x05+\x0dUp\x05/\x0dDn\x05,\x0d PgUp\x05/\x0dDn\x05: Move one page \x0dup\x05 or \x0ddown\x05."),w);
  1177.     Write(sys.ADR(" \x0dT\x05,\x0d Home \x05/\x0d B\x05,\x0d End\x05:   Goto \x0dt\x05op / \x0db\x05ottom of text."),w);
  1178.     Write(sys.ADR(" \x0dF\x05,\x0dN\x05,\x0dP\x05:              \x0dF\x05ind string, \x0dN\x05ext, \x0dP\x05revious occurance"),w);
  1179.     Write(sys.ADR(" \x0dShift \x05+\x0d Fn\x05:         Set textmarker #n to current position"),w);
  1180.     Write(sys.ADR(" \x0dFn\x05:                 Goto marker #n or set marker #n if it wasn't set yet"),w);
  1181.     Write(sys.ADR(" \x0dG\x05:                  \x0dG\x05oto line #n"),w);
  1182.     Write(sys.ADR(" \x0dNK 0\x05:               Display Filelength etc."),w);
  1183.     Write(sys.ADR(" \x0dShift \x05+\x0d Alt \x05+\x0d O\x05:    Create print\x0do\x05ut of the text"),w);
  1184.     Write(sys.ADR(" \x0dW\x05:                  \x0dW\x05rite block between Marker #1 and #2 to file or prt"),w);
  1185.     Write(sys.ADR(" \x0dL\x05:                  \x0dL\x05oad new text (arp necessary)"),w);
  1186.     Write(sys.ADR(" \x0dHELP\x05,\x0d H\x05:            Show Commands."),w);
  1187.     Write(sys.ADR(" \x0dESC\x05,\x0d Q\x05,\x0d X\x05,\x0d NK 5\x05:\x0d    Q\x05uit."),w);
  1188.     Write(sys.ADR(" \x0dS\x05:                  Go to \x0dS\x05leep, pop up with left Alt-ESC."),w);
  1189.     Write(sys.ADR(empty),w);
  1190.     Write(sys.ADR("© \x131990 Fridtjof Siebert, Nobileweg 67, D-7000 Stuttgart 40"),w);
  1191.     Write(sys.ADR("  \x13Please refer to MuchMorePoPa.ReadMe for a detailed copyright notice"),w);
  1192.     Write(sys.ADR("  \x13Decruncher is © Aug 1989 by Nico François"),w);
  1193.     Write(sys.ADR(empty),w);
  1194.     Write(sys.ADR("  This is another product of the Amiga MODULA & OBERON Klub Stuttgart - \x0d\x13AMOK"),w);
  1195.     i := (NumLines-24) DIV 2;
  1196.     WHILE i>0 DO Write(sys.ADR(empty),w); DEC(i) END;
  1197.     LOOP
  1198.       e.WaitPort(Window.userPort);
  1199.       MyMsgPtr := sys.VAL(LONGINT,e.GetMsg(Window.userPort));
  1200.       IF (I.rawKey IN MyMsgPtr.class) AND (MyMsgPtr.code<128) THEN EXIT END;
  1201.       e.ReplyMsg(MyMsgPtr);
  1202.     END;
  1203.     e.ReplyMsg(MyMsgPtr);
  1204.     BottomLine := TopLine;
  1205.     NewDisplay
  1206.   END Help;
  1207.  
  1208.  
  1209.   PROCEDURE Bottom;  (* executed when END or B is pressed *)
  1210.  
  1211.   BEGIN
  1212.     WaitAllRead;
  1213.     BottomLine := LastLine;
  1214.     i := NumLines;
  1215.     WHILE (i>1) AND (BottomLine.prev#NIL) DO
  1216.       BottomLine := BottomLine.prev;
  1217.       DEC(i);
  1218.     END;
  1219.     NewDisplay
  1220.   END Bottom;
  1221.  
  1222.  
  1223.   PROCEDURE Space(): BOOLEAN;  (* executed if space or LMB is pressed *)
  1224.   (* IF result=w THEN EXIT END *)
  1225.  
  1226.   BEGIN
  1227.     Fast := Shift;
  1228.     IF (MyFile=NIL) AND (BottomLine.next=NIL) THEN
  1229.       IF End THEN RETURN w ELSE End:=w END;
  1230.     ELSE
  1231.       End := f;
  1232.     END;
  1233.     IF Down THEN
  1234.       IF Scroll OR End THEN DisplayInfo END;
  1235.       Scroll := NOT(Scroll);
  1236.     ELSE
  1237.       Down := w;
  1238.       Scroll := w;
  1239.     END;
  1240.     RETURN f;
  1241.   END Space;
  1242.  
  1243.  
  1244.   PROCEDURE BackSpace;  (* executed if backspace or RMB is pressed *)
  1245.  
  1246.   BEGIN
  1247.     Fast := Shift;
  1248.     Scroll := Down OR NOT Scroll;
  1249.     Down := f
  1250.   END BackSpace;
  1251.  
  1252.  
  1253. BEGIN
  1254.  
  1255.   sys.SETREG(13,e.exec.thisTask.userData);
  1256.   sys.SETREG(0,e.Wait(mySig));
  1257.  
  1258.   Down := w; End := f; Find[0] := 0X; Goto[0] := 0X;
  1259.  
  1260.   LOOP
  1261.  
  1262.     IF NewDisp THEN NewDisp := f; NewDisplay END;
  1263.  
  1264. (*------  Type Text:  ------*)
  1265.  
  1266.     LOOP
  1267.       IF Scroll THEN
  1268.         IF Down THEN
  1269.           ScrollDown(Fast);
  1270.           Scroll := (MyFile#NIL) OR (BottomLine.next#NIL);
  1271.         ELSE
  1272.           ScrollUp(Fast);
  1273.           Scroll := TopLine.prev#NIL;
  1274.         END;
  1275.       ELSE
  1276.         e.WaitPort(Window.userPort);
  1277.       END;
  1278.  
  1279.       MyMsgPtr := sys.VAL(LONGINT,e.GetMsg(Window.userPort));
  1280.  
  1281.       IF (MyMsgPtr#NIL) THEN
  1282.         IF NOT (I.inactiveWindow IN MyMsgPtr.class) THEN EXIT END;
  1283.         EXCL(Window.idcmpFlags,I.mouseButtons);
  1284.         e.ReplyMsg(MyMsgPtr);
  1285.         e.WaitPort(Window.userPort);
  1286.         INCL(Window.idcmpFlags,I.mouseButtons);
  1287.       END;
  1288.     END;
  1289.  
  1290.     MyMsg := MyMsgPtr^;
  1291.     e.ReplyMsg(MyMsgPtr);
  1292.  
  1293.     IF MyMsg.code<80H THEN
  1294.       IF    Info           THEN DelLine; Info := f;
  1295.       ELSIF MyMsg.code=0FH THEN DisplayInfo; Scroll := f END;
  1296.     END;
  1297.  
  1298.     Shift := {} # {ie.lShift,ie.rShift,ie.capsLock} * MyMsg.qualifier;
  1299.     Alt   := {} # {ie.lAlt  ,ie.rAlt}               * MyMsg.qualifier;
  1300.     Sync  := NOT  (                     ie.control IN MyMsg.qualifier);
  1301.     IF NOT(Sync OR Alt) THEN Shift := TRUE END;
  1302.  
  1303.     IF I.mouseButtons IN MyMsg.class THEN
  1304.  
  1305.       IF    (ie.leftButton  IN MyMsg.qualifier) AND Space() THEN EXIT
  1306.       ELSIF ie.rightButton IN MyMsg.qualifier               THEN BackSpace END;
  1307.  
  1308.     ELSIF (I.rawKey IN MyMsg.class) AND (MyMsg.code<80H) THEN
  1309.  
  1310.       CASE MyMsg.code OF
  1311.  
  1312.       40H:  IF Space() THEN EXIT END |                   (* Space *)
  1313.  
  1314.       41H:  BackSpace |                                (* BackSpace *)
  1315.  
  1316.       4DH,1EH,1FH:                                        (* Down *)
  1317.             IF Shift THEN
  1318.               Scroll := NOT(Down AND Scroll) OR NOT Fast;
  1319.               Fast := w; Down := w;
  1320.             ELSE
  1321.               IF Alt OR (MyMsg.code=1FH) THEN i:=NumLines-1 ELSE i:=1 END;
  1322.               REPEAT
  1323.                 ScrollDown(NOT Shift);
  1324.                 DEC(i);
  1325.               UNTIL i=0;
  1326.               Scroll := f;
  1327.             END |
  1328.  
  1329.       4CH,3EH,3FH:                                        (* Up *)
  1330.             IF Shift THEN
  1331.               Scroll := Down OR NOT Scroll OR NOT Fast;
  1332.               Fast := w; Down := f;
  1333.             ELSE
  1334.               IF Alt OR (MyMsg.code=3FH) THEN i:=NumLines-1 ELSE i:=1 END;
  1335.               REPEAT
  1336.                 ScrollUp(NOT Shift);
  1337.                 Scroll := f;
  1338.                 DEC(i);
  1339.               UNTIL i=0;
  1340.             END; |
  1341.  
  1342.       44H,43H:                                        (* CR *)
  1343.             ScrollDown(f);
  1344.             Scroll := f; |
  1345.  
  1346.       3DH: BottomLine := FirstLine; NewDisplay |      (* Home *)
  1347.  
  1348.       1DH: Bottom |                                   (* End *)
  1349.  
  1350.       50H..59H:                                       (* F1..F10 *)
  1351.             i := MyMsg.code-50H;
  1352.             IF NOT Shift AND (TextMarkers[i]#NIL) THEN
  1353.               BottomLine := TextMarkers[i];
  1354.               IF BottomLine.prev#NIL THEN BottomLine := BottomLine.prev END;
  1355.               NewDisplay;
  1356.             ELSE
  1357.               TextMarkers[i] := TopLine;
  1358.             END |
  1359.  
  1360.       5FH:  Help |
  1361.  
  1362.       45H,2EH: IF NOT Alt THEN EXIT END |             (* Quit *)
  1363.  
  1364.       ELSE
  1365.  
  1366.         IF MyMsg.code<40H THEN (* examine vanilla keycode: *)
  1367.  
  1368.           chr := KeyMap[MyMsg.code];
  1369.  
  1370.           CASE chr OF
  1371.  
  1372.           "t": BottomLine := FirstLine; NewDisplay |      (* Home *)
  1373.  
  1374.           "b": Bottom |                                   (* End *)
  1375.  
  1376.           "f","n","p":                            (* Find, Next, Previous *)
  1377.  
  1378.             IF chr="f" THEN
  1379.               GetString(Find,f); FindLine := NIL; flen := 0;
  1380.               LOOP
  1381.                 FindStr[flen] := CAP(Find[flen]);
  1382.                 IF    FindStr[flen]>80X THEN DEC(FindStr[flen],32)
  1383.                 ELSIF FindStr[flen]=0X  THEN EXIT END;
  1384.                 INC(flen);
  1385.               END;
  1386.               ClearBitMaps();
  1387.             END;
  1388.             found := f;
  1389.             IF FindStr[0]#0X THEN
  1390.               i := NumLines;
  1391.               IF FindLine#NIL THEN FindLine := FindLine.next END;
  1392.               WHILE (i>0) AND (BottomLine#NIL) AND (BottomLine#FindLine) DO
  1393.                 BottomLine := BottomLine^.prev; DEC(i);
  1394.               END;
  1395.               IF (BottomLine#FindLine) OR (BottomLine=NIL) THEN BottomLine := TopLine END;
  1396.               IF chr#"p" THEN (* next *)
  1397.                 WHILE (BottomLine#NIL) AND NOT Search() DO
  1398.                   sys.SETREG(0,TryBottomnext());
  1399.                   BottomLine := BottomLine.next;
  1400.                 END;
  1401.               ELSE                   (* previous *)
  1402.                 IF BottomLine.prev#NIL THEN BottomLine:=BottomLine.prev END;
  1403.                 REPEAT
  1404.                   BottomLine := BottomLine.prev
  1405.                 UNTIL (BottomLine=NIL) OR Search();
  1406.               END;
  1407.             ELSE
  1408.               BottomLine := NIL
  1409.             END;
  1410.             ChkBotNewDisp |
  1411.  
  1412.           "w":                                                  (* write block *)
  1413.  
  1414.             IF (TextMarkers[0]#NIL) AND (TextMarkers[1]#NIL) AND NOT print AND NOT save THEN
  1415.               savefrom := 0; savesize := 0;
  1416.               l := TextMarkers[0].prev; WHILE l.prev#NIL DO l := l.prev; INC(savefrom,l.len) END;
  1417.               l := TextMarkers[1].prev; WHILE l#NIL DO INC(savesize,l.len); l := l.prev END;
  1418.               l := TextMarkers[1]; i := NumLines; WHILE (i>1) AND (l#NIL) DO DEC(i); INC(savesize,LONG(l.len)); l := l.next END;
  1419.               DEC(savesize,savefrom);
  1420.               IF savesize>0 THEN
  1421.                 GetString(WriteName,f);
  1422.                 WaitAllRead; save := w; e.Signal(sys.ADR(Me.task),mySig); NewDisplay;
  1423.               END
  1424.             END |
  1425.  
  1426.           "o": IF Shift AND Alt AND NOT print AND NOT save THEN                (* Printout *)
  1427.                  PStr := 'TYPE "'; Append(PStr,sys.ADR(Name)); Append(PStr,sys.ADR('" TO PRT:'));
  1428.                  WaitAllRead; print := w; e.Signal(sys.ADR(Me.task),mySig);
  1429.                END |
  1430.  
  1431.           "l": ClearBitMaps;                                      (* Load Text *)
  1432.                MakeThink(TRUE); NewText := w; e.Signal(sys.ADR(Me.task),mySig);
  1433.                REPEAT UNTIL (mySigBit IN e.Wait(mySig)) AND NOT NewText |
  1434.  
  1435.           "g":                                                     (* goto *)
  1436.             GetString(Goto,w);
  1437.             li := SHORT(StrInfo.longInt);
  1438.             BottomLine := FirstLine;
  1439.             WHILE (li>0) AND TryBottomnext() DO
  1440.               BottomLine := BottomLine.next;
  1441.               DEC(li)
  1442.             END;
  1443.             NewDisplay |
  1444.  
  1445.           "h": Help |                                              (* Help *)
  1446.  
  1447.           "q","x": EXIT |                                          (* Quit *)
  1448.  
  1449.           "s":                                                (* Disappear *)
  1450.  
  1451.             IF NOT print AND NOT save AND (e.FindPort(MMissleeping)=NIL) THEN
  1452.               InputData.sleeping := w;
  1453.               e.Signal(sys.ADR(Me.task),mySig);
  1454.               sys.SETREG(0,e.Wait(mySig));
  1455.             END |
  1456.  
  1457.           ELSE END;
  1458.  
  1459.         END;   (* IF MyMsg.code<40H THEN *)
  1460.  
  1461.       END;   (* CASE MyMsg.code OF *)
  1462.  
  1463.     END;   (* IF I.rawKey IN MyMsg.class THEN *)
  1464.  
  1465.   END;   (* LOOP *)
  1466.  
  1467.   Done := w;
  1468.   e.Signal(sys.ADR(Me.task),mySig);
  1469.   LOOP sys.SETREG(0,e.Wait(LONGSET{})) END;
  1470.  
  1471. END ShowProc;
  1472.  
  1473.  
  1474. (*--------------------------  File Requester:  ----------------------------*)
  1475.  
  1476.  
  1477. PROCEDURE FileReq;
  1478.  
  1479.  
  1480. TYPE
  1481.   TagItem = STRUCT
  1482.               typ: LONGINT;
  1483.               data: LONGINT;
  1484.             END;
  1485.  
  1486. CONST
  1487.   tagDone   = 0;
  1488.   tagIgnore = 1;
  1489.   tagUser   = MIN(LONGINT);
  1490.   dummy     = tagUser + 80000H;
  1491.   taghail   = dummy + 1;
  1492.   leftEdge  = dummy + 3;         (* Initialize LeftEdge                  *)
  1493.   topEdge   = dummy + 4;         (* Initialize TopEdge                   *)
  1494.   width     = dummy + 5;
  1495.   height    = dummy + 6;
  1496.   hookFunc  = dummy + 7;         (* Hook function pointer                *)
  1497.   file      = dummy + 8;         (* Initial name of file follows         *)
  1498.   dir       = dummy + 9;         (* Initial string for filerequest dir   *)
  1499.  
  1500.  
  1501. TYPE
  1502.   NineTags = ARRAY 8 OF TagItem;
  1503.  
  1504. VAR
  1505.   fr: FileRequesterPtr;
  1506.   tags: NineTags;
  1507.   res: BOOLEAN;
  1508.  
  1509.  
  1510.   PROCEDURE AllocFileRequest {asl,-30} (tag{8}: ARRAY OF TagItem)    : FileRequesterPtr;
  1511.   PROCEDURE FreeFileRequest  {asl,-36} (fr{8}: FileRequesterPtr);
  1512.   PROCEDURE RequestFile      {asl,-42} (fr{8}: FileRequesterPtr): BOOLEAN;
  1513.  
  1514.   PROCEDURE FileRequest{arp,-294}(VAR filereq{8}: FileRequester): BOOLEAN;
  1515.  
  1516.  
  1517. BEGIN
  1518.   LOOP
  1519.     j := Length(Name);
  1520.     WHILE (j>0) AND (Name[j]#":") AND (Name[j]#"/") DO DEC(j) END;
  1521.     IF j=0 THEN j := -1 END;
  1522.     i := 0;
  1523.     WHILE i<=j DO Dirname[i] := Name[i]; INC(i) END; Dirname[i] := 0X;
  1524.     j := 0;
  1525.     REPEAT Filename[j] := Name[i]; INC(j); INC(i) UNTIL Name[i-1]=0X;
  1526.     sys.SETREG(0,I.WBenchToFront());
  1527.     IF asl=NIL THEN asl := e.OpenLibrary("asl.library",36) END;
  1528.     IF asl#NIL THEN
  1529.       tags := NineTags(taghail, sys.ADR(MuchText),
  1530.                        file,    NIL,
  1531.                        dir,     NIL,
  1532.                        leftEdge,20,
  1533.                        topEdge, 20,
  1534.                        width,   300,
  1535.                        height,  200,
  1536.                        tagDone, NIL);
  1537.       tags[1].data := sys.ADR(Filename);
  1538.       tags[2].data := sys.ADR(Dirname);
  1539.       fr := AllocFileRequest(tags);
  1540.       IF fr=NIL THEN Request(sys.ADR(oom)) END;
  1541.       res := RequestFile(fr);
  1542.       FreeFileRequest(fr);
  1543.       IF NOT res THEN EXIT END;
  1544.       Dirname := fr.ddir^;
  1545.       Filename := fr.ddef^;
  1546.     ELSE
  1547.       IF arp=NIL THEN arp := e.OpenLibrary("arp.library",34) END;
  1548.       IF arp#NIL THEN
  1549.         FR.hail := sys.ADR(MuchText);
  1550.         FR.ddef := sys.ADR(Filename);
  1551.         FR.ddir := sys.ADR(Dirname);
  1552.         FR.wind := NIL;
  1553.         IF NOT FileRequest(FR) THEN EXIT END;
  1554.       ELSE
  1555.         Request(sys.ADR(noarp))
  1556.       END;
  1557.     END;
  1558.     Name := Dirname;
  1559.     i := Length(Name);
  1560.     IF (i>0) THEN
  1561.       CASE Name[i-1] OF "/",":": ELSE
  1562.         Name[i] := "/"; INC(i);
  1563.       END;
  1564.     END;
  1565.     j := 0;
  1566.     LOOP
  1567.       Name[i] := Filename[j];
  1568.       IF (Name[i]=0X) OR (i=255) THEN EXIT END;
  1569.       INC(i);
  1570.       INC(j);
  1571.     END;
  1572.     Name[i] := 0X;
  1573.     IF Screen#NIL THEN I.ScreenToFront(Screen) END;
  1574.     IF Window#NIL THEN I.ActivateWindow(Window) END;
  1575.     RETURN
  1576.   END;
  1577.   HALT(0);
  1578. END FileReq;
  1579.  
  1580.  
  1581. (*------  Sleep:  ------*)
  1582.  
  1583. PROCEDURE Sleep();
  1584.  
  1585. BEGIN
  1586.   InputDevPort.node.name := sys.ADR(MMissleeping);
  1587.   InputData.sleeping := w;
  1588.   sys.SETREG(0,e.Wait(mySig));
  1589.   InputDevPort.node.name := sys.ADR(MMisawake);
  1590. END Sleep;
  1591.  
  1592. (*------------------------------  MAIN:  ----------------------------------*)
  1593.  
  1594.  
  1595. BEGIN
  1596.  
  1597. (*------  Init:  ------*)
  1598.  
  1599. (* These variables are automatically set to zero:
  1600.   Screen := NIL; Window := NIL; FirstLine := NIL; TopLine := NIL;
  1601.   BottomLine := NIL; MyFile := NIL; AnzLines := 0; Info := f;
  1602.   MyLock := NIL; FileInfo := NIL; ScreenPos := 0; arp := NIL;
  1603.   ShowTaskRunning := f; SignalNewData := f; SignalAllRead := f;
  1604.   Done := f; print := f; bg := 0; style := SHORTSET{}; OldDir := NIL;
  1605.   InputOpen := f; save := f; in := NIL; out := NIL;
  1606. *)
  1607.   mySigBit := -1; Me := sys.VAL(d.ProcessPtr,ol.Me); fg := 1;
  1608.   InputDevPort.sigBit := -1;
  1609.   WriteName := "PRT:"; MemIndex := ChunkSize; OldDir := Me.currentDir;
  1610.   Sync := TRUE;
  1611.  
  1612.   I.GetPrefs(sys.ADR(Prefs),sys.SIZE(Prefs));
  1613.   lace := Prefs.laceWB;
  1614.  
  1615.   mySigBit := e.AllocSignal(-1);
  1616.   IF mySigBit<0 THEN HALT(0) END;
  1617.   mySig := LONGSET{mySigBit};
  1618.  
  1619. (*------  Setup:  ------*)
  1620.  
  1621.   NEW(FirstLine);
  1622. (*FirstLine.size := 0;
  1623.   FirstLine.text[0] := 0X; *)
  1624.   NEW(FileInfo);
  1625.   IF FileInfo=NIL THEN Request(sys.ADR(oom)) END;
  1626.  
  1627. (*------  Init InputHandler:  ------*)
  1628.  
  1629.   InputData.wakeUpSignal := SHORT(mySigBit);
  1630.   InputData.sigTask := sys.ADR(Me.task);
  1631.   InputData.sleeping := f;
  1632.  
  1633. (* InputDevPort := CreatePort(NIL,0) *)
  1634.   InputDevPort.node.name := sys.ADR(MMisawake);
  1635.   InputDevPort.node.type:= e.msgPort;
  1636.   InputDevPort.flags := e.signal;
  1637.   InputDevPort.sigBit := e.AllocSignal(-1);
  1638.   IF InputDevPort.sigBit<0 THEN HALT(0) END;
  1639.   e.AddPort(sys.ADR(InputDevPort));
  1640.   InputDevPort.sigTask := sys.ADR(Me.task);
  1641. (* InputRequestBlock := CreateStdIO(InputDevPort) *)
  1642.   InputRequestBlock.message.node.type := e.message;
  1643.   InputRequestBlock.message.length := sys.SIZE(InputRequestBlock);
  1644.   InputRequestBlock.message.replyPort := sys.ADR(InputDevPort);
  1645.  
  1646.   HandlerStuff.data := sys.ADR(InputData);
  1647.   HandlerStuff.node.pri := 51;
  1648.  
  1649.   IF e.OpenDevice("input.device",0,sys.ADR(InputRequestBlock),LONGSET{})#0 THEN
  1650.     Request(sys.ADR("Need input.device"))
  1651.   END;
  1652.   InputOpen := w;
  1653.  
  1654.   HandlerStuff.code := InputHandler;
  1655.   InputRequestBlock.command := Input.addHandler;
  1656.   InputRequestBlock.data := sys.ADR(HandlerStuff);
  1657.   e.DoIO(sys.ADR(InputRequestBlock));
  1658.   HandlerActive := w;
  1659.  
  1660. (*------  Start:  ------*)
  1661.  
  1662.   IF ol.wbStarted THEN
  1663.  
  1664.     wbm := ol.wbenchMsg;
  1665.  
  1666.     IF wbm.numArgs=2 THEN
  1667.       ArgPtr := wbm.argList^[1].name; Name := ArgPtr^;
  1668.       sys.SETREG(0,d.CurrentDir(wbm.argList^[1].lock));
  1669.     ELSE
  1670.       sys.SETREG(0,d.CurrentDir(wbm.argList^[0].lock));
  1671.       FileReq
  1672.     END
  1673.  
  1674.   ELSE
  1675.  
  1676.     IF ol.dosCmdLen<=1 THEN
  1677.       FileReq
  1678.     ELSE
  1679.       CommLine := ol.dosCmdBuf;
  1680.       LOOP
  1681.         i:=0;
  1682.         WHILE CommLine^=20X DO INC(CommLine) END;
  1683.         IF CommLine^=0AX THEN EXIT END;
  1684.         IF CommLine^='"' THEN
  1685.           INC(CommLine);
  1686.           LOOP
  1687.             CASE CommLine^ OF
  1688.             '"': INC(CommLine); EXIT |
  1689.             0AX:                EXIT |
  1690.             ELSE
  1691.               Name[i] := CommLine^; INC(i); INC(CommLine);
  1692.             END;
  1693.           END;
  1694.         ELSE
  1695.           WHILE (CommLine^#0AX) AND (CommLine^#20X) DO
  1696.             Name[i] := CommLine^; INC(i); INC(CommLine);
  1697.           END;
  1698.         END;
  1699.         Name[i]:= 0X;
  1700.         IF Name="?"  THEN Request(sys.ADR(usage)) END;
  1701.         IF (Name[0]="-") AND (Name[2]=0X) THEN
  1702.           Name[0] := 0X;
  1703.           CASE Name[1] OF
  1704.             "s": Sleep        |
  1705.             "l": lace := NOT lace |
  1706.           END;
  1707.         END;
  1708.       END;
  1709.     END;
  1710.  
  1711.   END;
  1712.  
  1713.  
  1714.   InitScreen();
  1715.  
  1716.   LOOP
  1717.     Decrunch;
  1718.     MyFile := d.Open(Name,d.oldFile);
  1719.     IF MyFile#NIL THEN EXIT END;
  1720.     FileReq
  1721.   END;
  1722.  
  1723. (*------  Get KeyMap:  ------*)
  1724.  
  1725.  
  1726.   IF e.OpenDevice("console.device",-1,sys.ADR(wreq),LONGSET{})#0 THEN Request(sys.ADR(conerr)) END;
  1727.   console := wreq.device;
  1728. (*ievent.nextEvent := NIL;
  1729.   ievent.qualifier := {};
  1730.   ievent.eventAddress := NIL; *)
  1731.   ievent.class := ie.rawkey;
  1732.   i := 0;
  1733.   WHILE i<40H DO
  1734.     ievent.code := i;
  1735.     RawKeyConvert(sys.ADR(ievent),sys.ADR(KeyMap[i]),32,NIL);
  1736.     INC(i);
  1737.   END;
  1738.  
  1739. (*------  Init 2nd Task:  ------*)
  1740.  
  1741.   ShowTask.spLower := sys.ADR(ShowStack);
  1742.   ShowTask.spUpper := sys.ADR(ShowStack[999]);
  1743.   ShowTask.spReg   := ShowTask.spUpper;
  1744.   ShowTask.node.type := e.task;
  1745.   ShowTask.node.name := sys.ADR("Show.MM");
  1746.   ShowTask.node.pri  := Me.task.node.pri+1;
  1747.   ShowTask.userData  := sys.REG(13);           (* VarBase *)
  1748.  
  1749.   e.Forbid;
  1750.     e.AddTask(sys.ADR(ShowTask),ShowProc,NIL);
  1751.     ShowTaskRunning := w;
  1752.     Window.userPort.sigTask := sys.ADR(ShowTask);
  1753.   e.Permit;
  1754.  
  1755. (*------  Main Load / Display Loop:  ------*)
  1756.  
  1757.   LOOP
  1758.  
  1759.     RQLen := -1; RQPos := -1;
  1760.     AnzLines := 1;
  1761.     LastLine := FirstLine;
  1762.     BottomLine := FirstLine;
  1763.     TopLine    := FirstLine;
  1764.     TextLength := 0;
  1765.     FindLine   := NIL;
  1766.     i := 0; REPEAT TextMarkers[i] := NIL; INC(i) UNTIL i=10;
  1767.  
  1768.     MyLock := d.Lock(Name,d.sharedLock);
  1769.     IF MyLock=NIL THEN Request(sys.ADR(cof)) END;
  1770.     IF NOT d.Examine(MyLock,FileInfo) THEN Request(sys.ADR(cof)) END;
  1771.     FileLength := FileInfo.size;
  1772.  
  1773.     d.UnLock(MyLock); MyLock := NIL;
  1774.     IF FileLength=0 THEN Request(sys.ADR("File empty")) END;
  1775.  
  1776.     (*------  Start displaying & Loading:  ------*)
  1777.  
  1778.     NewDisp := TRUE;
  1779.  
  1780.     e.Signal(sys.ADR(ShowTask),mySig);
  1781.  
  1782.     REPEAT
  1783.       LoadLine := GetTextLine();
  1784.       IF LoadLine=NIL THEN
  1785.         d.Close(MyFile);
  1786.         MyFile := NIL;
  1787.       ELSE
  1788.         LoadLine.prev := LastLine;
  1789.         LastLine.next := LoadLine;
  1790.         LastLine := LoadLine;
  1791.       END;
  1792.       IF SignalNewData THEN e.Signal(sys.ADR(ShowTask),mySig) END;
  1793.     UNTIL (MyFile=NIL) OR Done OR NewText OR InputData.sleeping;
  1794.     IF SignalAllRead THEN e.Signal(sys.ADR(ShowTask),mySig) END;
  1795.     REPEAT
  1796.       sys.SETREG(0,e.Wait(mySig));
  1797.       IF print THEN
  1798.         in := d.Open(nil,d.oldFile); out := d.Open(nil,d.newFile);
  1799.         sys.SETREG(0,d.Execute(PStr,in,out));
  1800.         d.Close(in); in := NIL; d.Close(out); out := NIL; print := f;
  1801.       END;
  1802.       IF save THEN
  1803.         in := d.Open(Name,d.oldFile);
  1804.         IF in=NIL THEN I.DisplayBeep(NIL) ELSE
  1805.           ol.New(buffer,savesize);
  1806.           IF buffer=NIL THEN Request(sys.ADR(oom)) END;
  1807.           sys.SETREG(0,d.Seek(in,savefrom,0));
  1808.           IF d.Read(in,buffer^,savesize)#savesize THEN
  1809.             I.DisplayBeep(NIL); d.Close(in); in := NIL;
  1810.           ELSE
  1811.             d.Close(in); in := NIL;
  1812.             out := d.Open(WriteName,d.newFile);
  1813.             IF out=NIL THEN I.DisplayBeep(NIL) ELSE
  1814.               IF d.Write(out,buffer^,savesize)#savesize THEN I.DisplayBeep(NIL) END;
  1815.               d.Close(out); out := NIL;
  1816.             END;
  1817.           END;
  1818.           DISPOSE(buffer);
  1819.         END;
  1820.         save := f;
  1821.       END;
  1822.       IF Done THEN EXIT END;
  1823.     UNTIL NewText OR InputData.sleeping;
  1824.     IF MyFile#NIL THEN d.Close(MyFile); MyFile := NIL END;
  1825.     IF DeCrunched THEN
  1826.       IF d.DeleteFile(Name) THEN END;
  1827.       Name := OldName;
  1828.     END;
  1829.     DisposeLines();
  1830.     FirstLine^.next := NIL; NewText := f;
  1831.     IF InputData.sleeping THEN
  1832.       CloseDisplay;
  1833.       Sleep;
  1834.       InitScreen;
  1835.       Window.userPort.sigTask := sys.ADR(ShowTask);
  1836.     END;
  1837.     REPEAT
  1838.       FileReq;
  1839.       Decrunch;
  1840.       MyFile := d.Open(Name,d.oldFile);
  1841.     UNTIL MyFile#NIL;
  1842.   END;   (* LOOP *)
  1843.  
  1844. CLOSE   (* cleanup: *)
  1845.  
  1846.   IF ShowTaskRunning THEN e.RemTask(sys.ADR(ShowTask))       END;
  1847.   CloseDisplay;
  1848.   IF MyFile#NIL      THEN d.Close(MyFile)                END;
  1849.   IF DeCrunched AND d.DeleteFile(Name) THEN END;
  1850.   IF in#NIL          THEN d.Close(in)                    END;
  1851.   IF out#NIL         THEN d.Close(out)                   END;
  1852.   IF MyLock#NIL      THEN d.UnLock(MyLock)               END;
  1853.   IF OldDir#NIL      THEN sys.SETREG(0,d.CurrentDir(OldDir)) END;
  1854.   IF mySigBit>=0     THEN e.FreeSignal(mySigBit)         END;
  1855.   IF arp#NIL         THEN e.CloseLibrary(arp)            END;
  1856.   IF asl#NIL         THEN e.CloseLibrary(asl)            END;
  1857.   IF HandlerActive THEN
  1858.     InputRequestBlock.command := Input.remHandler;
  1859.     InputRequestBlock.data := sys.ADR(HandlerStuff);
  1860.     e.DoIO(sys.ADR(InputRequestBlock));
  1861.   END;
  1862.   IF InputOpen THEN e.CloseDevice(sys.ADR(InputRequestBlock)) END;
  1863.   IF InputDevPort.sigBit>0 THEN
  1864.     e.RemPort(sys.ADR(InputDevPort));
  1865.     e.FreeSignal(InputDevPort.sigBit)
  1866.   END;
  1867.  
  1868. END MuchMorePoPa.
  1869.  
  1870.  
  1871.